00100	C  ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
00200	C *** READS DATA FROM CLFX, TAIL, FERM, BREP, REST, DRAW1, DRAW2
00300	
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS
00600		COMMON /DL/X22,SAVER,NAME/RRJJ/RJJ(20)
00700		DIMENSION RPOS(2,40),LST(13),DP(-3/4),LX(14),LY(7),R(8,100)
00800		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,JCEN,KCEN
00900		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
01000		COMMON/ALF/INP(72),ML/XRN/RN(4000)/STF/RSTFAC(8),RSTJC
01100		COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,L,I,IX
01200		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/POSI/STFF(8),JJB,POS
01300		COMMON/DPY/ST(4000),WDS(250),MEDIT,GO	
01400		EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
01500		1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
01600		1,(JK,JQ(9)),(JF,JQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2)),(IT,LY(7))
01700		1,(RJC,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(RXGP,WDS(250))
01710		1,(RJK,RJQ(9)),(RJQJ,RJQ(8)),(SET4,RN(3920)),(R,RN(3001))
01800		1 ,(TOP,ST(3999)),(BOT,ST(4000)),(RJH,RJQ(6)),(RJI,RJQ(7))
01900		1,(RPOS(1,1),RN(3921)),(ST2,ST(2)),(IBL,LY(1)),(RJM,RJQ(11))
02000		1,(IE,LX(4)),(IP,LX(10)),(IM,LX(9)),(II,LX(6)),(IS,LX(12))
02100		DATA STFF/-369.0,-246.0,-123.0,0.0,123.0,246.0,369.0,450.0/
02200		1 ,LST/'NOTE','REST','CLEF','LINE','NUMB',
02300		1 'MISC','KSIG','SLUR','BEAM','STAFF','METER','TRILL','WORD'/
02400		1,DP/8*1/,LX/'A','C','D','E','G','I','J','L','M','P','R',
02500		1 'S','U','X'/
02600		1,LY/' ','A','B','D','E','F','T'/
02700	
02800		TOP2=-999
02900		RXGP=0
03000		I1=0
03100	C  RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
03200	2	CALL DPYSET(1,ST,4000)
03300		CALL TYPLOC(-200,-511)
03400		CALL DPYBRT(5)
03500		RPOS(1,1)=0
03600		PLOTIT=0
03700		RSZ=.845
03800		TOP=-999
03900		BOT=999
04000		JSTF=-1
04100		X22=0
04120		JCEN=0
04140		KCEN=0
04200		PLT=0
04300		PWDS(1)=1.
04400		EDX=-1
04500		SAVER=7
04600		DO 1402 K=1,8
04700	1402	RSTFAC(K)=1.
04800		REDIT=999.
04900		M=1
05000		ITEM=0
05100		ZERO=-1
05200		WDS(1)=4
05300	C  DATA IN DPY ARRAY STARTS AT WD.4!
05400		I=1
05500	1100	SCORE=-1
05600	1000	IREADX=0
05700		KNT=0
05800		CALL DPYOUT(1)
05900		IF(SCORE.OR.REND)GO TO 58
06000	C   REND=-1 LAST TIME IN SCORE SECTION
06100		CALL SCMSS
06200		I=ISC
06300		ITEM=ISITEM
06400		ST2=WDS(ITEM+1)
06500		CALL ACCPOG(1)
06600		IF(REND.NE.100)GO TO 553
06700	C   FOR ESCAPE FROM 'SCORE' SECTION
06800		GO TO 1100
06900	58	GO=-1
07000		GO TO 5505
07100	
07200	
07300	11	CALL NOTWRT
07400	57	IF(PLT)GO TO 6120
07500		IF(M.LE.I.AND.GO)CALL DPYOUT(1)
07600		IF(JA.EQ.101)GO TO 5531
07700		ITEM=ITEM+1
07800		IF(GO.GT.0)GO TO 20000
07900		K=ST2
08000		IF(X22.EQ.0)GO TO 20000
08100		CALL BOX(IBOX,RBOX,STFF)
08200		ST2=K
08300	20000	WDS(ITEM+1)=ST2
08400		IF(EDX.NE.-1.AND.M.LT.I)GO TO 6120
08500		IF(PLOTIT.EQ.-2)GO TO 2311
08600	C  SL=SAVE AFTER RESETTING LENGTH OF PAGE.  (SEE I2 IN SCX)
08700		PWDS(ITEM+1)=I
08800		PLT=0
08900		IF(GO.NE.0)GO TO 5531
09000		CALL DPYOUT(1)
09100		GO=-1
09200	
09300	5531	IF(IREADX.EQ.-2)GO TO 653
09400		IF(JSTF)GO TO 55
09500		JA=JSTF
09600		JSTF=-1
09700		GO TO 889
09800	C PUT IN A STAFF
09900	55	IF(IREADX.OR.SCORE.EQ.0)GO TO 553
10000	5505	SVST=ST2
10087	C CATCHES TYPO WITH 'C'
10100		K=ITEM+1
10200		IF(X22.EQ.0)GO TO 5503
10300		K=X22
10400		L=RN(MEDIT+1)
10500		IF(L.EQ.16)L=13
10600		IF(L.EQ.18)L=11
10700		IF(L.EQ.30)L=12
10702		IF(L.EQ.11)L=0
10800	C  CHANGE CODE NUMS FOR 18 AND 30 ****************
10900		TYPE 427,LST(L),(RN(L),L=MEDIT+1,MEDIT+3)
11000		IF(YED.LT.2)GO TO 5500
11100	C   YED IS SET AT 426
11200	5502	DO 5501 L=4,YED+2
11300	5501	TYPE 4271,L,RN(MEDIT+L)
11400		GO TO 5500
11500	891	DEL=0
11600	C   THIS NOT USED IF DEL=0 AT LN32510 ***********
11700		GO TO 6531
11800	
11900	5503	CALL HYDPOG(3)
12000	C  TO DELETE VERTICAL LINE (55)
12100		KED=0
12200	5500	IF(DEL)GO TO 891
12300		IF(IREADX)GO TO 653
12400	5504	IF(I1.EQ.IP)GO TO 2311
12500	59	TYPE 56,NAME,K,SVST
12600		JAB=JA
12700		SCORE=-1
12800		ACCEPT 89,INP
12900		DO 1313 LKX=1,14
13000	1313	IF(I1.EQ.LX(LKX))GO TO 2313
13100		LKX=0
13200	2313	LKX=LKX+1
13300	C  'SA'=SAVE; 'S'=SET; 'SB'=SAVE BIG; 'ST'=STAFF; 
13400		IF(X22.NE.0)GO TO(87,884,883,883,5313,87,884,87,883,87,59,883
13500		1,15,883,883),LKX
13600		GO TO(87,13,7555,14,5313,120,884,7555,883,7555,311,883,15,883
13700		1,59),LKX
13800	C                  A   C   D   E   G   I  J   L   M     P   R   S U(X
13900	C  HERE A=ALTER A GROUP, DE=DELETE A GROUP
14000	C  'DP'=DISPLAY OR HIDE WHICH STAVES.  D=DOWN N
14100	14	IF(I2-IE)883,13,884
14200	13	GO=1
14300		CALL GRED
14400		IF(JA.EQ.98)GO TO 5533
14500		KNT=0
14600		SCORE=0
14700		GO TO 65
14800	15	DO 3313 LKY=1,7
14900	3313	IF(I2.EQ.LY(LKY))GO TO(312,3121,3121,3121,312,115,884),LKY
15000	C                               BL  A    B     D    E   F   T
15100	C  'SF'= SAVE AND FIXUP (I HOPE THIS IS TEMPORARY)
15200	115	CALL FIXUP
15300		GO TO 5505
15400	C  RESETS FACTORS FOR SAVE AND REDISPLAY
15450	3121	IF(X22.NE.0)GO TO 5505
15500		SAVER=7
15600		CALL SAVIT
15700		GO TO 5505
15800	312	JA=55
15900		RJB=RN(MEDIT+2)
16000		RJC=55.
16100		GO TO 6531
16200	C  ABOVE FOR 'S'ET ALIGNMENT
16300	C  'S'=SET ALIGNMENT, 'A'=ALIGN IT.  'M'=MOVER 'C'= COPIER
16400	C  'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;  'P' #S = PLOT IT
16500	5313	K=-1
16600		DO 882 JA=3,10
16700	882	IF(INP(JA).NE.IBL)GO TO 884
16800		GO TO 883
16900	885	FORMAT(A2,21F)
17000	884	REREAD 885,K,RJB,RJQ
17100		JA=55
17200		IF(I1.EQ.II)JA=22
17300		IF(I2.EQ.IT)JA=44
17400		IF(I2.NE.'P')GO TO 6531
17500		IF(RJB.GT.5)GO TO 1886
17600	C  GO BACK AND RESET ALL
17700		K=RJB
17800		JA=0
17900	C  USE '5' FOR STAFF 0.
18000	888	IF(K.EQ.5)K=0
18100		DP(K)=-DP(K)
18200		JA=JA+1
18300		K=RJQ(JA)
18400		IF(K.EQ.0)GO TO 85
18500	C  JUMP OUT IF RJQ(JA)=0
18600		GO TO 888
18700	C  TO GET BACK ALL LINES TYPE 6+
18800	311	JA=0
18850		ML=0
18900		IF(I2.NE.'X')GO TO 884
19000	1886	DO 2886 K=-3,4
19100	2886	DP(K)=1
19200		IF(I1.NE.IP)GO TO 8851
19300	C PXG OR PXC RESETS 'DP'
19400	C  TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
19500	2311	CALL PLTCMD
19600		IF(PLOTIT.EQ.0)GO TO 3005
19700		I1=IP
19800		PLOTIT=-1
19900		GO TO 6531
20000	C  'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE
20100	
20200	881	IF(I1.GT.0)GO TO 87
20300	C   JUMP IF I1 IS NOT A LETTER (K>0=NUM, K<0=LET.)
20310	883	IF(I2.EQ.IS)GO TO 2
20320	C  TYPE 'RS' TO RESTART.
20350		IF(IX.EQ.I.AND.I1.EQ.'C')GO TO 72
20400		CALL EDIT(JJA,RJJB)
20500		GO TO 6531
20600	89	FORMAT(72A1)
20700	C  TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
20800	
20900	87	REREAD 1,JA,RJB,RJQ
21000		IF(K)JA=55
21100	C   ED 47 -1 = 55 47 -1, ETC.
21200		IF(JA.EQ.101)GO TO 11
21300		IF(JA.GT.0)SAVER=SAVER-1
21400		IF(SAVER.AND.X22.EQ.0)CALL SAVIT
21500	C  SAVES EVERY 7TH TIME AROUND
21510		IF(JA.EQ.14.OR.JA.EQ.16.OR.JA.EQ.144)GO TO 88
21600		GO TO 6531
21650	188	RJB=0
21700	88	RSTJC=RSTFAC(JC+4)
21710		SET4=RJB
21720	C  SET4 IS NEG. FOR AUTOMATIC STAFF 4 SETUP.
21800		IF(JA.NE.14)GO TO 889
21900	C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
21950		SAVER=-1
22000		DO 1889 K=1,I
22100		J=PWDS(K)
22200		IF(RN(J+1).NE.10)GO TO 1889
22300		IF(RN(J+3).EQ.RJC)GO TO 889
22400	1889	CONTINUE
22500	C DIDN'T FIND THIS STAFF
22600		JSTF=JA
22700		JA=10
22800		GO TO 6531
22900	889	SCORE=0
23000		ISC=I
23100		ISITEM=ITEM
23200	C   RETAINS ORIGINS OF SCORE SQUENCE
23300	CC	DO 9532 K=1,8
23400		DO 9532 L=3001,3800
23500	9532	RN(L)=0
23550	C  CLEARS R( , ) ARRAY
23600		REND=0
23700		RSTF=RJC
23800		R(1,1)=JA
23900		R(2,1)=RJB
24000		R(3,1)=RJD
24100		R(4,1)=RJE
24200		R(5,1)=RJF
24300		KNT=0
24400	9533	CALL SCMSS
24500		IREADX=-1
24600		IF(REND)GO TO 653
24700	553	IF(SCORE)GO TO 6531
24800	65	GO=1
24900	C  SO DPYOUT COMES ONLY ONE PER LINE.
25000	653	KNT=KNT+1
25100	C   NUM OF ITEMS IN LIST
25200		RJK=0
25300		RJQJ=0
25400		RJI=0
25500		JA=R(1,KNT)
25600		RJB=R(2,KNT)
25700		IF(JA.NE.100)GO TO 550
25800		IF(REND.NE.1.)GO TO 1000
25900	C   =1 GOES BACK FOR MORE
26000		KNT=0
26100		IF(RJB.LT.0)GO TO 188
26200	C  WILL READ ANOTHER STAFF
26300		GO TO 1100
26400	C  100 STOPS READER.
26500	550	DO 7531 K=1,6
26600	7531	RJQ(K)=R(K+2,KNT)
26610		IF(RJG.EQ.1.9)RJQJ=1
26620	C  FOR GRACE NOTE SLASH
26650	CC	RJI=AMOD(RJC,1.)
26660		IF(JA.EQ.9)GO TO 16
26700		IF(JA.NE.999)GO TO 6531
26800	C  999 MEANS P9 AND P10 ARE USED WITH BEAMS
26900		JA=9
27000		RJQ(8)=R(3,KNT)
27100		RJI=R(2,KNT)
27200		RJB=RJJB
27300		RJC=RJJ(1)
27310	16	RJK=-1
27400	6531	M=1
27500		EDX=-1
27600		IF(JA.EQ.222)GO TO 72
27700		IF(JA.EQ.2222)GO TO 73
27800		DO 5532 K=1,10
27900	5532	JQ(K)=RJQ(K)
28000		IF(JA.NE.99.AND.JA.NE.98)GO TO 7542
28100		CALL DELETE
28200		IF(JA.EQ.99)GO TO 425
28300	5533	X22=0
28400		GO=-1
28500		CALL DPYNEW
28600		GO TO 55
28700	
28800	590	IF(PLOTIT.EQ.-1)GO TO 121
28900		I1=0
29000		GO TO 243
29100	C  GOES TO PLOTTER
29200	7542	IF(I1.EQ.'P')GO TO 590
29300	C  X22= ITEM# WHEN EDITING OR DELETING.
29400		IF(X22.NE.0)GO TO 5511
29500		IF(JA.GT.0)GO TO 155
29600		IF(RJB.NE.0)GO TO 6221
29700	C  FOR UP, DOWN, LEFT, RIGHT
29800		GO TO 5505
29900	C  GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
30000	155	IF(JA.EQ.24)GO TO 24
30100		IF(JA.EQ.22)GO TO 42  
30200		IF(JA.EQ.44)GO TO 44
30300		IF(JA.EQ.55)GO TO 554
30400		IF(JA.EQ.333)GO TO 6333
30500		IF(IABS(JC).GT.5.OR.(IABS(JD).GT.50.AND.JA.GT.4.AND.
30600		1 JA.NE.9.AND.JA.NE.10))GO TO 5505
30700	C  CATCHES SOME TYPO ERRORS IN P3 AND P4.
30800	C  AVOIDS EXIT AFTER TYPO ERROR
30900		IF(JA.EQ.21.OR.JA.EQ.19)GO TO 61
31100		GO TO 60
31110	
31115	33	JB=RJB
31116		RJB=RJJ(JB-2)
31117		IF(JB.EQ.2)RJB=RJJB
31120		TYPE 1,JB,RJB
31130	C  TYPE 33,N TO SEE FULL CONTENTS OF PARAM. N.
31140		GO TO 5505
31200	
31300	24	GO=0
31350		IF(ABS(RJB).GT.99)GO TO 5505
31400		IF(RJB.NE.0)GO TO 241
31500		GO=-1
31600	243	RJB=1.
31700	C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
31800	241	RSZ=.845*RJB
31900		JCEN=RJC*RSZ
32000		KCEN=RJD*RSZ
32100		RJB=0
32200		RJC=0
32300		RJD=0
32400		TOP=-999
32500		BOT=999
32600	85	M=1
32700		I=PWDS(ITEM+1)
32800		ITEM=0
32900	8552	ST2=3
33000	8852	PLT=1
33100		EDX=0
33200		CALL ACCPOG(1)
33300		IF(JA.NE.24)GO=0
33400		GO TO 6120
33500	
33600	6333	CALL LISTP(LST)
33700		GO TO 5505
33800	
33900	172	CALL JUGGLE
34000	272	CALL DPYNEW
34100		IF(JA.EQ.22)GO TO 424
34200	C  FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
34300		IF(ZERO)GO TO 55
34400		X22=ZERO
34500		ZERO=-1
34600		IF(JA.EQ.55)GO TO 554
34700		IF(JA.EQ.44)GO TO 44
34800		IF(KED.NE.0)GO TO 244
34900		GO TO 425
35000	
35100	C  55,POS  -- SETS UP ALIGNMENT
35200	554	CALL BOX(-1,RJB,STFF)
35300		IF(JD.EQ.0)KED=-1
35400		RITEM=RJD
35500	C  FOR 'ED POS., STF., CODE#'
35600		IF(JC.GT.4)KED=-2
35700		RLINE=RJB
35800		RJB=RJC
35900		GO TO 45
36000	
36100	C  '22,0' EDITS LAST ITEM ENTERED
36200	42	IF(RJB.NE.0)GO TO 242
36300		X22=ITEM
36400		GO TO 429
36500	44	KED=1	
36600		RITEM=RJC
36700	C  'ST', STF#, CODE# (IF 0, ALL ITEMS COME UP)
36800	45	REDIT=RJB
36900	C  THE STAFF #
37000		JED=1
37100	244	X=ITEM  
37200		IF(JED.GT.X)GO TO 444
37300		DO 144 K=JED,X
37400		L=PWDS(K)
37500		IF(KED.EQ.-2)GO TO 654
37600	C  -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
37700		IF(RN(L+3).NE.REDIT)GO TO 144
37800		IF(KED)GO TO 654
37900		IF(RITEM.NE.0.AND.RITEM.NE.RN(L+1))GO TO 144
38000		IF(JA.NE.55)GO TO 344
38100	654	IF(ABS(RLINE-RN(L+2)).LT.5.0)GO TO 344
38200	144	CONTINUE
38300	444	REDIT=999.
38400	C  NO MORE ON LINE
38500		RJB=0
38600	C   SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
38700		GO TO 73
38800	344	JED=K+1
38900	C  FOR NEXT TIME AROUND
39000		X22=K
39100		GO TO 429
39200	C  CR MOVES ALONG GIVEN LINE,  222 LEAVES THIS MODE
39300	
39400	91	CALL ACCPOG(1)
39500		IF(I.EQ.IX)ITEM=ITEM-1
39600		GO TO 142
39700	242	IF(X22.GT.0)GO TO 5511
39800	142	IF(RJB.NE.0)GO TO 424
39900		IF(REDIT.NE.999..AND.JA.GE.0)GO TO 244
40000		X22=X22+1
40100		IF(JA)X22=X22-1+JA
40200		IF(X22.LT.1)X22=1
40300		GO TO 425
40400	424	X22=RJB
40500	425	IF(X22.GT.ITEM)GO TO 73
40600	C  LEAVES EDIT MODE.
40700	429	IX=I
40800		MEDIT=PWDS(X22)
40900		J=2
41000	426	Y=RN(MEDIT)+J
41100		CALL LOOP(0,Y,1,I,MEDIT,RN)
41200		JJA=RN(I+1)
41300		YED=Y-2
41400		L=I+2
41500		DO 422 K=1,11
41600		IF(K.GT.YED)GO TO 423
41700		RJJ(K)=RN(L+K)
41800		GO TO 422
41900	423	RJJ(K)=0
42000	422	CONTINUE
42100		RJJB=RN(L)
42200		IF(GO.GT.0)GO TO 4231
42300	C  NO BOX WHEN IN GROUP EDIT ROUTINE
42400		IBOX=I
42500		RBOX=RJJ(1)
42600		CALL BOX(IBOX,RBOX,STFF)
42700	4231	ITEM=ITEM+1
42800		ST2=WDS(ITEM)
42900		GO TO 55
43000	427	FORMAT(1XA5/,F4.0,F7.2,F6.2,$)
43100	4271	FORMAT('+  (',I2,')',F7.2,$)
43200	
43300	C  FOR EDITING
43400	5511	IF(JA.EQ.55)GO TO 420
43500	220	IF(JA.NE.22)GO TO 720
43600	C  'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
43700		KED=0
43800		JED=0
43900		GO TO 72
44000	720	IF(JA.EQ.44)GO TO 420
44010		IF(JA.EQ.33)GO TO 33
44100		IF(JA.GT.13.OR.JA.EQ.1)GO TO 5505
44200	C  PARAM NUM TOO HIGH?
44300	C  LOOKS FOR NEXT ITEM TO EDIT IF <CR>
44400	4221	IF(X22.EQ.0.OR.RJB.NE.0)GO TO 5517
44500	C  BACKS UP WHEN IN EDIT MODE.
44600	
44700		IF(JA.GT.0)GO TO 5518
44800		IF(I.EQ.IX)GO TO 91
44900		ZERO=X22+1
45000	C  '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
45100	72	IF(X22.EQ.0)GO TO 55
45200		IF(KED.EQ.0)REDIT=999.
45300	320	IF(I.NE.IX)GO TO 172
45400		ITEM=ITEM-1
45500	C  TO DELETE AN ITEM
45600	73	X22=0 
45700		CALL DPYNEW
45800		IF(REDIT.EQ.999.)GO TO 441
45900		IF(JA.EQ.55)GO TO 554
46000		IF(JA.EQ.44)GO TO 44
46100	441	IF(RJB.EQ.0.OR.RJB.GT.ITEM)GO TO 55
46200		GO TO 424
46300	C  DELETION IN EDIT MODE DOES NOT LEAVE MODE.
46400	
46500	5517	IF(JA.EQ.0)GO TO 6221
46600	5518	IF(JA.EQ.2)GO TO 7221
46700		IF(JA.GE.22)GO TO 55
46800		RJJ(JA-2)=RJB
46900		RJB=RJJB
47000		GO TO 6222
47100	
47200	7555	CALL MOVER
47300		IF(RJC.EQ.99)GO TO 5504
47400	C   99=BACKUP OUT OF MOVER ETC.
47500	8853	IF(JJB)GO TO 57
47600		M=PWDS(JJB)
47700		I=PWDS(ITEM+1)
47800		ITEM=JJB-1
47900		ST2=WDS(JJB)
48000	C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
48100		GO TO 8852
48200	
48300	8851	IF(I1.NE.IP)GO TO 85
48400		GO TO 6531
48500	
48600	420	REDIT=0
48700	211	IF(RJB.NE.0)GO TO 320
48800		IF(KED.GE.0)RLINE=RJJB
48900		RJB=RLINE
49000	C  FOR '55' ALIGNING
49100	7221	RJJB=RJB
49200	6222	IF(JQ(1).EQ.0)GO TO 6221
49300	C  ARRAYS NEED 2O LOCATIONS HERE.
49400	C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122  4,13  5,-2 ETC.)
49500		DO 1222 K=1,20,2
49600		L=JQ(K)
49700		IF(L-2)6221,2222,3222
49800	3222	RJJ(L-2)=RJQ(K+1)
49900		GO TO 1222
50000	2222	RJJB=RJQ(K+1)
50100		RJB=RJJB
50200	1222	CONTINUE
50300	C***  LOOP SET TO 10 (20 IN ARRAY!)
50400	6221	DO 5514 K=1,11
50500		RJQ(K)=RJJ(K)
50600	5514	JQ(K)=RJQ(K)
50700		JA=JJA
50800		ITEM=ITEM-1
50900		IF(ITEM)ITEM=0
51000		ST2=WDS(ITEM+1)
51100		I=PWDS(ITEM+1)
51110		CALL DPYNEW
51120	
51130	60	IF(DP(JC))GO TO 57
51140		RSTJC=RSTFAC(JC+4)
51150		RD=0
51152		IF(JA.EQ.50)JA=16
51156	C  ABOVE SHOULD BE TAKEN OUT AT SOME FUTURE DATE. (12/73)
51160		IF(RJB.LT.1000)GO TO 66
51165		RD=RJB
51190		IF(JA.EQ.8)RJM=RJB/1000.
51270		CALL RNOTE(RJB)
51370	C IF RJB>1000 IT FINDS TRUE RJB THROUGH NOTE NUMB.
51490	66	IF(EDX.EQ.0.OR.I1.EQ.IP)GO TO 5541
51500		RJJB=RJB
51700		JJA=JA
51800		IF(JA.NE.16.OR.RJI.EQ.0)GO TO 160
51900	CC360	RJI=0
52125		RJB=RN(IFIX(PWDS(X22-1))+2)+39.6*RSTJC*RJE
52200	C  PUTS 13TH(+) LETTER TIN RIGHT POS. AFTER HORIZ. MOVE.
52390	160	IF(JA.EQ.1.AND.RJH.EQ.0)RJH=999.
52400	C  999=0 FOR STEM EXTENSIONS.
52410		CNT=1
52500		DO 5543 K=1,9
52503	C  10/6/73 ABOVE WAS ,11
52510		RA=RJQ(K)
52520		IF(RA.NE.0)CNT=K
52600	5543	RJJ(K)=RA
52800	C  USES ONLY 10 PARAMETERS BEYOND JA, JB
53400	2554	IF(PLT.NE.0)GO TO 5541
53500		IF(JA.EQ.9)CALL HOMER
53600		IF(JA.NE.6)GO TO 1261
53700		IF(JF.NE.0)RJM=-1
53800	
53900	1261	IF(RJM.NE.0)CALL HOMER
54000	C  IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
54100	C **** FOR '0' EDITS ******
54200	261	RN(I)=CNT
54300		RN(I+1)=JA
54400		I=I+2
54500		RN(I)=RJB
54510		IF(RD.NE.0)RN(I)=RD
54520	C TO SAVE NOTE NUMBS IN P2.
54600		DO 4554 K=1,CNT
54700	4554	RN(I+K)=RJQ(K)
54800	3554	I=CNT+1+I
54900	C  WHAT ABOUT EDITS?*******
55000	5541	POS=STFF(JC+4)
55100		JB=RHORZ(RJB)
55200	C  LINE IS DIVIDED INTO 200 POINTS.
55300		CENTR=POS
55400	551	IF(JA.EQ.4.OR.JA.EQ.10)GO TO 25
55500		IF(JA.EQ.7)GO TO 81
55600		IF(JA.LE.12.OR.JA.EQ.30)GO TO 11
55700		IF(JA.EQ.18)GO TO 80
55800		IF(JA.NE.88)GO TO 116
55802		IF(RJB.EQ.0)RJB=1
55804	C  USE ONLY ONE 88 CHANGE PER STAFF!!!! ********
55900		RSTFAC(JC+4)=RJB
56000	C   88,FAC,STF   SETS STAFF SIZE FACTOR(ALSO CAN BE DONE WITH 10)
56100		GO TO 57
56200	116	IF(JA.NE.16.AND.JA.NE.20)GO TO 120
56300		CALL ALPHA
56400		GO TO 57
56500	
56600	81	CALL KSIG
56700		GO TO 57
56800	
56900	80	CALL METER
57000		GO TO 57
57100	
57200	61	CALL HOMER
57300		GO TO 8853
57400	
57500	25	CALL ITMSUB
57600	C   BAR LINES, BEAMS, STAFF LINES ****
57700		GO TO 57
57800	
57900	C  TO GET DISPLAY: 'G'; 'GM'  ADDS TO DPY; 
58000	120	IF(I.NE.1.AND.I2.NE.IM)GO TO 5505
58100	C  'GM'=GET MORE
58200		TYPE 21
58300		ACCEPT FA5,NAME
58400		IF(NAME.EQ.'99')GO TO 5505
58500		IF(NAME.NE.IBL.AND.LOOKD(NAME).EQ.0)GO TO 120
58600	C  FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
58700	3005	REWIND 21
58800	C  GUARDS AGAINST LOSSAGE!
58900		PLOTIT=-1
58950		IF(I1.NE.'G')PLOTIT=-2
59000	2005	IF(NAME.EQ.IBL)GO TO 2200
59100		CALL IFILE(21,NAME)
59200	C  JUMP TO READ BIG FILES
59300	2200	J=ITEM+1
59400	2202	READ(21,END=2207),X,Y,
59500		1 (PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2),ISCR,(V(K),K=1,ISCR),
59510		1 LCNT,(LIST(K),K=1,LCNT)
59600	CC PUT IN NEXT YEAR(12/73)1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF
59700	2207	IF(Y.EQ.0)GO TO 2205
59800		ITEM=ITEM+X
59900		IF(I2.EQ.IM)GO TO 2203
60000		I=Y
60100		READ(21,END=8851),RSTFAC,STFF
60110		IF(I1.EQ.IP)GO TO 6531
60200		READ(21,END=8851),ST2,(ST(K),K=1,ST2+2),(WDS(K),K=1,ITEM+1)
60300		CALL DPYNEW
60400		GO TO 5505
60500	2205	TYPE 2206
60600		CALL EXIT
60700	2206	FORMAT(' **** UNPACK IT! ****')
60800	
60900	2203	RA=I-1
61000		DO 2204 K=J,J+X
61100	2204	PWDS(K)=PWDS(K)+RA
61200		GO TO 85
61300	121	IF(PLOTIT.EQ.0)GO TO 5504
61400	5121	CALL PLTSRT
61500	C  IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
61600		PLT=-1-JH
61700	C  (JH) P8=1 OR 2 FOR 2-PASS PLOTS
61800		M=I
61900		I=I+M-1
62000		IF(RJB.EQ.0)RJB=1.
62100		DIS=RJB*1.24
62200		IF(RJC.EQ.0)RJC=RJB
62300		RHT=RJC*1.2
62400	C   1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
62500		BOT=-BOT*RHT
62600		IF(TOP2.EQ.-999)GO TO 8121
62700		BOT=BOT+TOP2
62800		GO TO 9121
62900	8121	CALL PLOTS(K)
63000		RXGP=995.-BOT
63100	9121	NOMOVE=RJF+RJG*148.*RJC
63200	C  RJF=1 FOR NO MOVE AT END.  RJG=# OF STAVES TO MOVE FOR NEW STAFF 0.
63300		IXGP=JD
63400	C (JD) P4=1 FOR XGP OUTPUT
63500		IF(JE.NE.0)GO TO 1122
63600		IF(RJD.EQ.0)GO TO 6121
63700		IF(TOP2.NE.-999)RXGP=RXGP-BOT
63800	C  MOVES 0 POINT OVER EACH TIME.
63900		GO TO 1122
64000	6121	CALL PLOT(0,BOT,-3)
64100	C  MOVES PLOTTER UP IF P5=0.
64200	1122	X22=IXGP
64300	
64400	C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
64500	6120	IF(M.GE.I)GO TO 7120
64600		CNT=RN(M)
64700	C  CLEARS INPUT ARRAY, USES ONLY 12 PARAMS.
64800		DO 6220 K=CNT+1,10
64900		JQ(K)=0
65000	6220	RJQ(K)=0
65100		JA=RN(M+1)
65110		M=M+2
65200		RJB=RN(M)
65400		DO 9120 K=1,CNT
65500		RJQ(K)=RN(M+K)
65600	9120	JQ(K)=RJQ(K)
65700		M=CNT+M+1
65800		IF(EDX.LE.0)GO TO 60
65900		GO TO 5505
66000	
66100	7120	M=1
66200		IF(EDX)GO TO 71201
66300		IF(PLT.EQ.1)EDX=-1
66400		PLT=0
66500	C  RETURNS FOR 'SL'=SAVE LAST
66600		GO TO 5505
66700	71201	X=50*RHT
66800		TOP=TOP*RHT+X
66900		IF(NOMOVE.NE.0)TOP=0
67000		IF(NOMOVE.GT.1)TOP=NOMOVE
67100		IF(IXGP.EQ.0)CALL PLOT(0,TOP,3)
67200		TOP2=TOP
67300		GO TO 2
67400	C  TO MOVE 'PLOTTER' FOR XGP OUTPUT
67500	CC7121	CALL PLOT(0,TOP,3)
67600	C  MOVES PLOTTER UP
67700	C  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
67800	CC	TOP2=TOP
67900	CC	GO TO 2
68000	
68100	56	FORMAT(/1XA5,'  TYPE FOR ITEM #',I3,I/)
68200	1	FORMAT(I,24F)
68300	21	FORMAT(' FILE NAME?'/)
68400		END